home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Use Micros19195542001.psc / Form1.frm (.txt) < prev   
Encoding:
Visual Basic Form  |  2001-04-10  |  11.0 KB  |  219 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   2385
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   3840
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   2385
  10.    ScaleWidth      =   3840
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton Command1 
  13.       Caption         =   "Create Despatch Note"
  14.       Height          =   495
  15.       Left            =   720
  16.       TabIndex        =   0
  17.       Top             =   720
  18.       Width           =   2175
  19.    End
  20. Attribute VB_Name = "Form1"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Option Explicit
  26. ' If the same variable name is used more than once in the template, this
  27. ' array saves the application performing the same work again to get that
  28. ' data.  It simply lifts it from this array.
  29. Private UsedVariables() As String
  30. Private Sub Command1_Click()
  31.     FillTemplates
  32. End Sub
  33. Private Sub FillTemplates()
  34.     Dim WordApp As Word.Application
  35.     Dim WordDoc As Word.Document
  36.     Dim i As Integer, j As Integer
  37.     Dim NewResult As String
  38.     On Error GoTo ErrHandler
  39.     ReDim UsedVariables(0)
  40.     Set WordApp = CreateObject("Word.Application")
  41.     Set WordDoc = WordApp.Documents.Open(App.Path & "\template.doc")
  42.     ' For each section (header and footer)
  43.     For i = 1 To WordDoc.Sections.Count
  44.         ' Headers
  45.         Debug.Print "Fields in Header:" & WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields.Count
  46.         For j = 1 To WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields.Count
  47.         
  48.             If WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j).Type = wdFieldDocVariable Then
  49.             
  50.                 ' Get the text for the field from the user
  51.                 NewResult = GetNewResult(WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j), WordDoc)
  52.                 'Insert New Text into the field
  53.                 If NewResult <> "" Then
  54.                     WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j).Result.Text = NewResult
  55.                 End If
  56.                 
  57.             End If
  58.         
  59.         Next
  60.         
  61.         ' Footers
  62.         Debug.Print "Fields in Footer:" & WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields.Count
  63.         For j = 1 To WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields.Count
  64.         
  65.             If WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j).Type = wdFieldDocVariable Then
  66.         
  67.                 ' Get the text for the field from the user
  68.                 NewResult = GetNewResult(WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j), WordDoc)
  69.                 'Insert New Text into the field
  70.                 If NewResult <> "" Then
  71.                     WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j).Result.Text = NewResult
  72.                 End If
  73.             
  74.             End If
  75.         
  76.         
  77.         Next
  78.     Next
  79.                 
  80.     ' In main body
  81.     Debug.Print "Fields in main body: " & WordDoc.Fields.Count
  82.     For i = 1 To WordDoc.Fields.Count
  83.             
  84.         If WordDoc.Fields(i).Type = wdFieldDocVariable Then
  85.             ' Get the text for the field from the user
  86.             NewResult = GetNewResult(WordDoc.Fields(i), WordDoc)
  87.             'Insert New Text into the field
  88.             If NewResult <> "" Then
  89.                 WordDoc.Fields(i).Result.Text = NewResult
  90.             End If
  91.                 
  92.         End If
  93.                 
  94.     Next
  95.         
  96.     ' lock the document to stop changes
  97.     WordDoc.Protect wdAllowOnlyComments, , "jd837djh82"
  98.     WordDoc.SaveAs App.Path & "\despatchnote.doc"
  99.     WordDoc.Close
  100.     WordApp.Quit
  101.     Set WordDoc = Nothing
  102.     Set WordApp = Nothing
  103.     MsgBox "Finished!"
  104. Exit Sub
  105. ErrHandler:
  106.     MsgBox "Unhanled Error: " & Err.Description
  107. End Sub
  108. Private Function GetNewResult(wField As Word.Field, WordDoc As Word.Document) As String
  109.     Dim StopPos As Long
  110.     Dim Variable As String
  111.     Dim UsedVariable As String
  112.     Dim VariableValue As String
  113.     Dim wRange As Word.Range
  114.     Debug.Print wField.Code
  115.     ' These three lines strip down the field code to find
  116.     ' out it's name
  117.     StopPos = InStrRev(wField.Code, "\*")
  118.     Variable = Left(wField.Code, StopPos - 3)
  119.     Variable = Right(Variable, Len(Variable) - 14)
  120.     ' Check this field hasn't already appeared in this
  121.     ' document.
  122.     If CheckUsedVariable(Variable) Then
  123.                   
  124.         VariableValue = GetVariableValue(Variable)
  125.         
  126.     Else
  127.         
  128.         Select Case UCase(Variable)
  129.         
  130.             ' I don't simply want to insert a string -
  131.             ' I wish to insert a table at the Product Field.
  132.             Case "PRODUCT"
  133.                                             
  134.                 ' Get the range (location) of the product field
  135.                 Set wRange = wField.Code
  136.                 ' Delete the field, as any text will be inserted into the
  137.                 ' {} of the existing field.
  138.                 wField.Delete
  139.                 
  140.                 ' Enter our table information including headers.
  141.                 ' Ideally, I would get this data from an ADO recordset
  142.                 ' using GetString().
  143.                 With wRange
  144.                 
  145.                     .Text = "PRODUCT" & vbTab & "CTSBATCHNO" & vbTab & "SUPP REF" & vbTab & "PACKNO" & vbTab & "STORAGE" & vbTab & "QTY UNITS" & vbCrLf & _
  146.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  147.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  148.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  149.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  150.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  151.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  152.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  153.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  154.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  155.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  156.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  157.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  158.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  159.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  160.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  161.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  162.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  163.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  164.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  165.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  166.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  167.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  168.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
  169.                                 "989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3"
  170.                                 
  171.                     .FormattedText.Font.Name = "Arial"
  172.                     .FormattedText.Font.Size = "8"
  173.                 
  174.                     ' Once the data is there, we can convert it to a table
  175.                     ' structure and format it to look pretty!
  176.                     .ConvertToTable vbTab, , , , wdTableFormatColorful2
  177.                 
  178.                 End With
  179.                 
  180.                 ' Send back blank string as field does not exist anymore
  181.                 VariableValue = ""
  182.         
  183.             Case Else
  184.                 
  185.                 ' Get the value of the field from the user
  186.                 VariableValue = InputBox("Enter value for: " & Variable, "Value not recognised for Despatch Note!")
  187.                 AddNewVariable Variable, VariableValue
  188.         
  189.         End Select
  190.         
  191.     End If
  192.     GetNewResult = VariableValue
  193.         
  194. End Function
  195. Private Function GetVariableValue(Variable As String) As String
  196. Dim i As Integer
  197.     For i = 0 To UBound(UsedVariables)
  198.         If Left(UsedVariables(i), Len(Variable)) = Variable Then
  199.             GetVariableValue = Right(UsedVariables(i), Len(UsedVariables(i)) - Len(Variable))
  200.             Exit For
  201.         End If
  202.     Next
  203. End Function
  204. Private Sub AddNewVariable(Variable As String, TheValue As String)
  205. Dim ArraySize As Integer
  206.     ArraySize = UBound(UsedVariables)
  207.     ReDim Preserve UsedVariables(ArraySize + 1)
  208.     UsedVariables(ArraySize) = Variable & TheValue
  209. End Sub
  210. Private Function CheckUsedVariable(Variable As String) As Boolean
  211. Dim i As Integer
  212.     For i = 0 To UBound(UsedVariables)
  213.         If Left(UsedVariables(i), Len(Variable)) = Variable Then
  214.             CheckUsedVariable = True
  215.             Exit For
  216.         End If
  217.     Next
  218. End Function
  219.